perm filename XPITCH.SAI[X,ALS] blob sn#088678 filedate 1974-02-25 generic text, type T, neo UTF8
00010	BEGIN "XRUN"
00020	DEFINE ⊂="COMMENT";
00030	
00040	⊂ This program runs another program, BXX, as a separate job and produces
00050	an XGP plot of formant data from the specified file. This program may
00060	be executed directly, in which case it requests info from the TTY, or it
00070	be called into being as a separate job and passed a number specifying
00080	the file to be used. In this second case this program automatically
00090	kills its job on completion;
00100	
00110	DEFINE ⊃="⊂";
00120	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00130	  INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN3,CHAN5,CHAN1,EOFT,EOF,BRCHR,
00140	    PP,POINTP,FLAG,MUTE,NUM,ITT,KTT,JTT,SCALE;
00150	  STRING FILEP,FILEN,FILEM,READ1,READ,READTT,TFILE,MEMO; BOOLEAN ER;
00160	  INTEGER ARRAY SAVE,JHSAVE[0:6];
00170	  INTEGER ARRAY LFILE[0:127];
00180	  INTEGER ARRAY NEW,BUFTT[0:511];
00190	  INTEGER ARRAY DPYBUF[0:4096];
00200	INTEGER A1,A2,A3;
00210	LABEL STARTP;
00220	INTEGER DATE,TIME;
00230	DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00240	PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00250		"SEP","OCT","NOV","DEC";
00260	STRING ARRAY MONTHS[0:11];
00270	
00280	INTERNAL STRING PROCEDURE DATIM;
00290	BEGIN
00300	INTEGER DAY,YR,HRS,MIN,SEC;
00310	DAY←(DATE MOD 31)+1;DATE←DATE%31;
00320	YR←1964+DATE%12; SEC←TIME MOD 60;
00330	TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00340	SETFORMAT(-2,0);
00350	RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00360	   "-"&CVS(YR)&"   "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00370	END;
00380	
00390	PROCEDURE DTTTIN;
00400	BEGIN
00410	INTEGER J;
00420	  FOR I←0 STEP 1 UNTIL 511 DO BUFTT[I]←0;
00430	  IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512);
00440	  FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00450	  ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00460	⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00470	END;
00480	
00490	
00500	INTERNAL STRING PROCEDURE WTIM;
00510	BEGIN
00520	DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00530	RETURN(DATIM);
00540	END;
00550	
00560	INTERNAL STRING PROCEDURE DATIME;
00570	BEGIN
00580	GETIME;
00590	RETURN(DATIM);
00600	END;
00610	
00620	
00625	⊂ If scale is 32 we allow;
00630	⊂  1140 units on a line corresponding to 76 charactters @15 units,
00640	   380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00650	
00660	
00670	PROCEDURE XPLOT;
00680	BEGIN "XPLOT"
00690	REQUIRE "SXF.REL[SAI,NJM]" LIBRARY;
00700	REQUIRE "XM.REL[FEB,NJM]" LIBRARY;
00710	REQUIRE "SIO.REL[SAI,NJM]" LIBRARY;
00720	EXTERNAL FORTRAN PROCEDURE XSET;
00730	EXTERNAL FORTRAN PROCEDURE XRVEC;
00740	EXTERNAL FORTRAN PROCEDURE XVEC;
00750	EXTERNAL FORTRAN PROCEDURE XIVEC;
00760	EXTERNAL FORTRAN PROCEDURE XIRVEC;
00770	EXTERNAL FORTRAN PROCEDURE XLINE;
00780	EXTERNAL FORTRAN PROCEDURE VERTAX;
00790	EXTERNAL FORTRAN PROCEDURE SWT25;
00800	EXTERNAL FORTRAN PROCEDURE PTX1;
00810	EXTERNAL FORTRAN PROCEDURE XOUT;
00820	EXTERNAL FORTRAN PROCEDURE XFIN;
00830	INTERNAL STRING XSTR,XSTR1,XSTR2,XSTRH;
00840	INTEGER XX,IX,IX2,IY,XREF,YREF,X2,Y2,HT,XSAVE,XCUT;
00850	INTEGER MIN,MAX,ERR;
00860	MIN←0;
00870	MAX←3500;
00880	XREF←400;
00890	YREF←200;
00900	HT←700;	⊂ Allowing 5 inches for 5000 hertz;
00910	XSET;
00920	
00930	SCALE←20
00935	;	⊂ Inverse to size, 32 was standard;
00940	
00960	XSAVE←0;
00970	
00980	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
00990	LOOKUP(CHAN5,FILEN,ERR);
01000	IF ERR THEN OUTSTR("FILE "&FILEP&"  NOT FOUND"&CRLF);
01010	ARRYIN(CHAN5,LFILE[0],'200);
01020	
01030	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
01040	LOOKUP(CHAN5,FILEP,ERR);
01050	FILEINFO(SAVE);
01060	IF ERR THEN OUTSTR("FILE "&FILEP&"  NOT FOUND"&CRLF);
01070	
01080	XSTR←""; FOR I←10 STEP 1 UNTIL 20 DO XSTR←XSTR&CVXSTR(LFILE[I]);
01090	IX←XREF; IY←100; SWT25(IX,IY);
01100	 READ←WTIM; SETFORMAT(1,0);
01110	
01120	XSTR←"Glottal pulse determination in file "
01130	     &FILEP&" (created "&READ&")";
01140	IX←XREF; IY← 1450; SWT25(IX,IY);
01150	XSTR←"with plot of determining rule (0 through 7) "&MEMO;
01160	IX←XREF+100; IY←1420; SWT25(IX,IY);
01170	XSTR←"Compared with pitch markers from file "&filem&" (created "
01175	   &READTT&")";
01180	IX←XREF; IY←1390; SWT25(IX,IY);
01190	XSTR←"A.I. Laboratory, Stanford University.   "&DATIME;
01200	IX←XREF+200; IY←1360; SWT25(IX,IY);
01201	XSTR←"7"; IX←XREF-20; IY←YREF+950-13+7*25; SWT25(IX,IY);
01202	XSTR←"6"; IY←YREF+950-13+6*25; SWT25(IX,IY);
01203	XSTR←"5"; IY←YREF+950-13+5*25; SWT25(IX,IY);
01204	XSTR←"4"; IY←YREF+950-13+4*25; SWT25(IX,IY);
01205	XSTR←"3"; IY←YREF+950-13+3*25; SWT25(IX,IY);
01206	XSTR←"2"; IY←YREF+950-13+2*25; SWT25(IX,IY);
01207	XSTR←"1"; IY←YREF+950-13+1*25; SWT25(IX,IY);
01208	XSTR←"0"; IY←YREF+950-13+0*25; SWT25(IX,IY);
01209	XOUT(XREF-8);
01210	
01220	FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
01230	  IF LFILE[I]=0 THEN DONE;
01240	  L←LFILE[I] LAND '777760000000;
01250	  J←LDB(POINT(14,LFILE[I],27))-1; K←LDB(POINT(8,LFILE[I],35))-1;
01260	
01270	  X←J*128%SCALE+K*64%SCALE-8; ⊂ X←(J+K%2)*128%SCALE-8; 
01277	
01280	  IF X<XSAVE+16 THEN X←XSAVE+16; XSAVE←X;
01290	  IX←XREF+X; IY←YREF-45; XSTR←(READ←CVSTR(L))[1 TO 1]; SWT25(IX,IY);
01300	  IF (XSTR←READ[2 TO 2])≠"" THEN BEGIN
01310	    IY←YREF-70; SWT25(IX,IY); END;
01320	
01330	  IX←XREF+J*128%SCALE; IX2←IX+K*128%SCALE;
01340	  XLINE(IX,YREF-20,IX,YREF);
01350	  XLINE(IX,YREF,IX2,YREF);
01360	  XLINE(IX,YREF-1,IX2,YREF-1);
01370	  XLINE(IX,YREF-2,IX2,YREF-2);
01380	  XLINE(IX2,YREF,IX2, YREF-20);
01390	
01400	  END "PONY";
01410	OUTSTR("Text,");
01480	
01490	XCUT←IX2+200;
01500	
01510	
01540	LY←YREF+950; LX←XREF; XIVEC(LX,LY);
01550	
01555	I←0; IX←XREF; IY←LY-30; XSTR←"Time in seconds→"; SWT25(IX,IY);
01556	SETFORMAT(1,0);
01558	
01560	FOR X←XREF STEP 2000%SCALE UNTIL IX2 DO BEGIN
01561	      XLINE(X,LY+7*25,X+2,LY+7*25);
01562	      XLINE(X,LY+6*25,X+6,LY+6*25);
01563	      XLINE(X,LY+5*25,X+2,LY+5*25);
01564	      XLINE(X,LY+4*25,X+6,LY+4*25);
01565	      XLINE(X,LY+3*25,X+2,LY+3*25);
01566	      XLINE(X,LY+2*25,X+6,LY+2*25);
01567	      XLINE(X,LY+1*25,X+2,LY+1*25);
01568	      XLINE(X,LY,X+6,LY);
01571	      IF ((I MOD 10)=0)∧(I≠0) THEN BEGIN
01572	        J←I%10; XSTR←CVS(J); IX←X-8; IY←LY-30; SWT25(IX,IY); END;
01573	      I←I+1;
01574	      END;
01576	IY←YREF+600;
01580	
01590	WHILE EOF=0 DO BEGIN "XDATIN"
01600	  FOR I←0 STEP 1 UNTIL 511 DO NEW[I]←0;
01610	  ARRYIN(CHAN5,NEW[0],512);
01620	    IF NEW[0]=0 THEN DONE "XDATIN";
01630	
01645	
01650	
01660	
01680	    FOR J←0 STEP 2 UNTIL 510 DO BEGIN
01690	      IF NEW[J]=0 THEN DONE;
01700	      XX←(NEW[J] LSH -15); X←XX%SCALE+XREF;
01701	
01702	      Y←(NEW[J] LAND '7)*25;
01703	      XVEC(LX,LY+Y); XVEC(X,LY+Y); LX←X;
01710	
01740	        IF (LDB(POINT(3,NEW[J],35))≠0) THEN BEGIN
01750	          Y←LDB(POINT(13,NEW[J],33))%20; XLINE(X,IY,X,Y+IY);
01760	          Y←LDB(POINT(13,NEW[J+1],12))%10; XLINE(X,YREF,X,YREF+Y);
01770	          END ELSE XLINE(X,IY,X,IY+2);
01775	WHILE (K←(BUFTT[KTT] LSH -15)%SCALE+XREF)≤X DO BEGIN
01777	  Y←(BUFTT[KTT] LAND '77777)%100;
01779	  XLINE(K,IY,K,IY-Y);
01781	  KTT←KTT+1; IF KTT≥512 THEN DTTTIN; END;
01783	
01784	    IF (J MOD 64)=0 THEN BEGIN
01785	      XOUT(X-100); OUTSTR(CVS(X)&",");
01810	      END;
01815	    END;
01820	
01850	  END "XDATIN";
01860	CLOSE(CHAN5);
01870	XOUT(XCUT); OUTSTR(CVS(XCUT)&CRLF);
01880	IF XCUT<2200 THEN BEGIN XCUT←2200; XOUT(XCUT); END;
01890	
01900	XFIN;
01910	END "XPLOT";
01920	
     

00010	CHAN1←1; CHAN3←3; CHAN5←5;
00020	STDBRK(1);
00030	STARTP:
00040	MUTE←60; NUM←3;
00050	CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,1,0,70,BRCHR,EOF);
00060	LOOKUP(CHAN1,"NUMBER.TMP",ER);
00070	IF ER THEN BEGIN
00080	OUTSTR("The following set-up commands of a letter followed by a number "
00090	  &"may be given:"&CRLF);
00100	OUTSTR("	M#	sets MUTE level (default value 60)"&CRLF&
00110	       "	N#	sets number of formants (default value 3)."&CRLF);
00120	OUTSTR("A number only uses preset values for M and N and specifies the file to use."
00130	      &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00140	SETFORMAT(1,0); FLAG←0; X←0;
00150	WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command  "); READ←INCHWL;
00160	IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00170	IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00180	DONE; END "TYPE";
00190	IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00200	END ELSE BEGIN
00210	  PP←CVD(INPUT(CHAN1,1));
00220	  CLOSE(CHAN1);
00230	  END;
00240	
00242	FILEN←"SEG"&CVS(PP)&".SYN[2,JH]";
00244	FILEP←"SEG"&CVS(PP)&".ASP[SYN,ALS]";
00246	FILEM←"SEG"&CVS(PP)&".T[PIT,NJM]";
00247	
00248	CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00250	LOOKUP(CHAN3,FILEM,ER); TFILE←FILEM;
00251	FILEINFO(SAVE); READTT←WTIM;
00252	IF ER THEN BEGIN
00254	  OUTSTR("File "&FILEM&" not found  (S to start, space bar to ignore) ");
00256	  IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00258	    BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00260	    CLRBUF; END; END;
00261	DTTTIN; CLOSE(CHAN3);
00262	
00264	XPLOT;
00280	PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF);
00300	
00310	END "XRUN";